home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Text / WASTE / WASTE 1.1.2 Distribution / WASTE Source / WEBirthDeath.p < prev    next >
Encoding:
Text File  |  1995-10-12  |  15.3 KB  |  593 lines  |  [TEXT/CWIE]
  1. unit WEBirthDeath;
  2.  
  3. { WASTE PROJECT: }
  4. { Creation and Destruction, Standard Procs, etc. }
  5.  
  6. { Copyright © 1993-1995 Marco Piovanelli }
  7. { All Rights Reserved }
  8.  
  9. interface
  10.     uses
  11.         WEHighLevelEditing;
  12.  
  13.     function WENew ({const} var destRect, viewRect: LongRect;
  14.                                     flags: Integer;
  15.                                     var hWE: WEHandle): OSErr;
  16.     procedure WEDispose (hWE: WEHandle);
  17.     function WEFeatureFlag (feature: Integer;
  18.                                     action: Integer;
  19.                                     hWE: WEHandle): Integer;
  20.     function WEGetInfo (selector: OSType;
  21.                                     info: Ptr;
  22.                                     hWE: WEHandle): OSErr;
  23.     function WESetInfo (selector: OSType;
  24.                                     info: Ptr;
  25.                                     hWE: WEHandle): OSErr;
  26.  
  27. implementation
  28.     uses
  29.         GestaltEqu, QDOffscreen, ToolUtils;
  30.  
  31.     var
  32.  
  33. { static variables }
  34.  
  35.         _weStdDrawTextProc: WEDrawTextUPP;
  36.         _weStdPixelToCharProc: WEPixelToCharUPP;
  37.         _weStdCharToPixelProc: WECharToPixelUPP;
  38.         _weStdLineBreakProc: WELineBreakUPP;
  39.         _weStdWordBreakProc: WEWordBreakUPP;
  40.         _weStdCharByteProc: WECharByteUPP;
  41.         _weStdCharTypeProc: WECharTypeUPP;
  42.  
  43.     procedure _WEStdDrawText (pText: Ptr;
  44.                                     textLength: LongInt;
  45.                                     slop: Fixed;
  46.                                     styleRunPosition: JustStyleCode;
  47.                                     hWE: WEHandle);
  48.     begin
  49.         DrawJustified(pText, textLength, slop, styleRunPosition, Point(kOneToOneScaling), Point(kOneToOneScaling));
  50.     end;  { _WEStdDrawText }
  51.  
  52.     function _WEStdPixelToChar (pText: Ptr;
  53.                                     textLength: LongInt;
  54.                                     slop: Fixed;
  55.                                     var width: Fixed;
  56.                                     var edge: SignedByte;
  57.                                     styleRunPosition: JustStyleCode;
  58.                                     hPos: Fixed;
  59.                                     hWE: WEHandle): LongInt;
  60.         var
  61.             tempPoint: Point;
  62.             lastWidth: Fixed;
  63.     begin
  64.         tempPoint := Point(kOneToOneScaling);
  65.         lastWidth := width;
  66.         _WEStdPixelToChar := PixelToChar(pText, textLength, slop, lastWidth, Boolean(edge), width, styleRunPosition, tempPoint, tempPoint);
  67.  
  68. { round width to nearest integer value }
  69. { (this is supposed to fix an incompatibility with the WorldScript Power Adapter) }
  70.         width := BSL(FixRound(width), 16);
  71.  
  72.     end;  { _WEStdPixelToChar }
  73.  
  74.     function _WEStdCharToPixel (pText: Ptr;
  75.                                     textLength: LongInt;
  76.                                     slop: Fixed;
  77.                                     offset: LongInt;
  78.                                     direction: Integer;
  79.                                     styleRunPosition: JustStyleCode;
  80.                                     hPos: LongInt;
  81.                                     hWE: WEHandle): Integer;
  82.     begin
  83.         _WEStdCharToPixel := CharToPixel(pText, textLength, slop, offset, direction, styleRunPosition, Point(kOneToOneScaling), Point(kOneToOneScaling));
  84.     end;  { _WEStdCharToPixel }
  85.  
  86.     function _WEStdLineBreak (pText: Ptr;
  87.                                     textLength: LongInt;
  88.                                     textStart, textEnd: LongInt;
  89.                                     var textWidth: Fixed;
  90.                                     var textOffset: LongInt;
  91.                                     hWE: WEHandle): StyledLineBreakCode;
  92.     begin
  93.         _WEStdLineBreak := StyledLineBreak(pText, textLength, textStart, textEnd, 0, textWidth, textOffset);
  94.     end;  { _WEStdLineBreak }
  95.  
  96.     procedure _WEStdWordBreak (pText: Ptr;
  97.                                     textLength: Integer;
  98.                                     offset: Integer;
  99.                                     edge: SignedByte;
  100.                                     var breakOffsets: OffsetTable;
  101.                                     script: ScriptCode;
  102.                                     hWE: WEHandle);
  103.     begin
  104.         FindWordBreaks(pText, textLength, offset, Boolean(edge), nil, breakOffsets, script);
  105.     end;  { _WEStdWordBreak }
  106.  
  107.     function _WEStdCharByte (pText: Ptr;
  108.                                     textOffset: Integer;
  109.                                     script: ScriptCode;
  110.                                     hWE: WEHandle): Integer;
  111.     begin
  112.         _WEStdCharByte := CharacterByteType(pText, textOffset, script);
  113.     end;  { _WEStdCharByte }
  114.  
  115.     function _WEStdCharType (pText: Ptr;
  116.                                     textOffset: Integer;
  117.                                     script: ScriptCode;
  118.                                     hWE: WEHandle): Integer;
  119.     begin
  120.         _WEStdCharType := CharacterType(pText, textOffset, script);
  121.     end;  { _WEStdCharType }
  122.  
  123.     function _WEScriptToFont (script: ScriptCode): Integer;
  124.     begin
  125.  
  126. { given an explicit script code, return the first font ID in the corresponding range }
  127. { for an explanation of the formula given below, see IM: Text, page B-8 }
  128.  
  129.         if (script = smRoman) then
  130.             _WEScriptToFont := 2
  131.         else if ((script > smRoman) and (script <= smUninterp)) then
  132.             _WEScriptToFont := $3E00 + $200 * script
  133.         else
  134.             _WEScriptToFont := systemFont;        { unknown script code (?) }
  135.  
  136.     end;  { _WEScriptToFont }
  137.  
  138. {$IFC NOT SystemSevenFiveOrLater}
  139.  
  140.     procedure _WEOldWordBreak (pText: Ptr;
  141.                                     textLength: Integer;
  142.                                     offset: Integer;
  143.                                     edge: SignedByte;
  144.                                     var breakOffsets: OffsetTable;
  145.                                     script: ScriptCode;
  146.                                     hWE: WEHandle);
  147.         var
  148.             savePort, tempPort: GrafPtr;
  149.             saveFont: Integer;
  150.     begin
  151.  
  152. { the old (now obsolete) FindWord routine gets an implicit script parameter through }
  153. { the current graphics port txFont field, so first of all we must have a valid port }
  154.         GetPort(savePort);
  155.         tempPort := hWE^^.port;
  156.         SetPort(tempPort);
  157.  
  158. { then set the txFont field to a font number in the specified script range }
  159.         saveFont := tempPort^.txFont;
  160.         TextFont(_WEScriptToFont(script));
  161.  
  162. { call _FindWord }
  163.         FindWord(pText, textLength, offset, Boolean(edge), nil, breakOffsets);
  164.  
  165. { restore font and port }
  166.         TextFont(saveFont);
  167.         SetPort(savePort);
  168.  
  169.     end;  { _WEOldWordBreak }
  170.  
  171.     function _WEOldCharByte (pText: Ptr;
  172.                                     textOffset: Integer;
  173.                                     script: ScriptCode;
  174.                                     hWE: WEHandle): Integer;
  175.         var
  176.             savePort, tempPort: GrafPtr;
  177.             saveFont: Integer;
  178.     begin
  179.  
  180. { the old (now obsolete) CharByte routine gets an implicit script parameter through }
  181. { the current graphics port txFont field, so first of all we must have a valid port }
  182.         GetPort(savePort);
  183.         tempPort := hWE^^.port;
  184.         SetPort(tempPort);
  185.  
  186. { then set the txFont field to a font number in the specified script range }
  187.         saveFont := tempPort^.txFont;
  188.         TextFont(_WEScriptToFont(script));
  189.  
  190. { call _CharByte }
  191.         _WEOldCharByte := CharByte(pText, textOffset);
  192.  
  193. { restore font and port }
  194.         TextFont(saveFont);
  195.         SetPort(savePort);
  196.  
  197.     end;  { _WEOldCharByte }
  198.  
  199.     function _WEOldCharType (pText: Ptr;
  200.                                     textOffset: Integer;
  201.                                     script: ScriptCode;
  202.                                     hWE: WEHandle): Integer;
  203.         var
  204.             savePort, tempPort: GrafPtr;
  205.             saveFont: Integer;
  206.     begin
  207.  
  208. { the old (now obsolete) CharType routine gets an implicit script parameter through }
  209. { the current graphics port txFont field, so first of all we must have a valid port }
  210.         GetPort(savePort);
  211.         tempPort := hWE^^.port;
  212.         SetPort(tempPort);
  213.  
  214. { then set the txFont field to a font number in the specified script range }
  215.         saveFont := tempPort^.txFont;
  216.         TextFont(_WEScriptToFont(script));
  217.  
  218. { call _CharType }
  219.         _WEOldCharType := CharType(pText, textOffset);
  220.  
  221. { restore font and port }
  222.         TextFont(saveFont);
  223.         SetPort(savePort);
  224.  
  225.     end;  { _WEOldCharType }
  226.  
  227. {$ENDC}
  228.  
  229.     function _WERegisterWithTSM (hWE: WEHandle): OSErr;
  230.  
  231. { the WE record must be already locked }
  232.  
  233.         label
  234.             1;
  235.         var
  236.             pWE: WEPtr;
  237.             typeList: InterfaceTypeList;
  238.             err: OSErr;
  239.     begin
  240.         pWE := hWE^;
  241.  
  242. { do nothing if the Text Services Manager isn't available }
  243.         if BTST(pWE^.flags, weFHasTextServices) then
  244.             begin
  245.                 typeList[0] := kTextService;
  246.                 err := NewTSMDocument(1, typeList, pWE^.tsmReference, LongInt(hWE));
  247.                 if (err <> noErr) then
  248.  
  249. { we don't consider it an error if our client application isn't TSM-aware }
  250.                     if (err <> tsmNeverRegisteredErr) then
  251.                         goto 1;
  252.             end;
  253.  
  254. { clear result code }
  255.         err := noErr;
  256.  
  257. 1:
  258. { return result code }
  259.         _WERegisterWithTSM := err;
  260.  
  261.     end;  { _WERegisterWithTSM }
  262.  
  263.     procedure _WESetStandardHooks (hWE: WEHandle);
  264.         var
  265.             pWE: WEPtr;
  266.     begin
  267.  
  268. { the first time we're called, create routine descriptors }
  269.         if (_weStdDrawTextProc = nil) then
  270.             begin
  271.                 _weStdDrawTextProc := NewWEDrawTextProc(@_WEStdDrawText);
  272.                 _weStdPixelToCharProc := NewWEPixelToCharProc(@_WEStdPixelToChar);
  273.                 _weStdCharToPixelProc := NewWECharToPixelProc(@_WEStdCharToPixel);
  274.                 _weStdLineBreakProc := NewWELineBreakProc(@_WEStdLineBreak);
  275.  
  276. {$IFC NOT SystemSevenFiveOrLater}
  277.  
  278.                 if (GetScriptManagerVariable(smVersion) < $710) then
  279.                     begin
  280.  
  281. { pre-7.1 version of the Script Manager: must use old hooks }
  282.                         _weStdWordBreakProc := NewWEWordBreakProc(@_WEOldWordBreak);
  283.                         _weStdCharByteProc := NewWECharByteProc(@_WEOldCharByte);
  284.                         _weStdCharTypeProc := NewWECharTypeProc(@_WEOldCharType);
  285.  
  286.                     end
  287.                 else
  288.  
  289. {$ENDC}
  290.  
  291.                     begin
  292.  
  293. { Script Manager version 7.1 or newer }
  294.                         _weStdWordBreakProc := NewWEWordBreakProc(@_WEStdWordBreak);
  295.                         _weStdCharByteProc := NewWECharByteProc(@_WEStdCharByte);
  296.                         _weStdCharTypeProc := NewWECharTypeProc(@_WEStdCharType);
  297.                     end;
  298.             end;  { if called for the first time }
  299.  
  300. { replace null hook fields with the addresses of the standard hooks }
  301.  
  302.         pWE := hWE^;
  303.  
  304.         if (pWE^.drawTextHook = nil) then
  305.             pWE^.drawTextHook := _weStdDrawTextProc;
  306.  
  307.         if (pWE^.pixelToCharHook = nil) then
  308.             pWE^.pixelToCharHook := _weStdPixelToCharProc;
  309.  
  310.         if (pWE^.charToPixelHook = nil) then
  311.             pWE^.charToPixelHook := _weStdCharToPixelProc;
  312.  
  313.         if (pWE^.lineBreakHook = nil) then
  314.             pWE^.lineBreakHook := _weStdLineBreakProc;
  315.  
  316.         if (pWE^.wordBreakHook = nil) then
  317.             pWE^.wordBreakHook := _weStdWordBreakProc;
  318.  
  319.         if (pWE^.charByteHook = nil) then
  320.             pWE^.charByteHook := _weStdCharByteProc;
  321.  
  322.         if (pWE^.charTypeHook = nil) then
  323.             pWE^.charTypeHook := _weStdCharTypeProc;
  324.  
  325.     end;  { _WESetStandardHooks }
  326.  
  327.     function WENew ({const} var destRect, viewRect: LongRect;
  328.                                     flags: Integer;
  329.                                     var hWE: WEHandle): OSErr;
  330.         label
  331.             1, 2;
  332.         var
  333.             pWE: WEPtr;
  334.             allocFlags: Integer;
  335.             weFlags: LongInt;
  336.             response: LongInt;
  337.             r: Rect;
  338.             err: OSErr;
  339.     begin
  340.         pWE := nil;
  341.         weFlags := flags;
  342.         allocFlags := kAllocClear;
  343.  
  344. { allocate the WE record }
  345.         err := _WEAllocate(SizeOf(WERec), allocFlags, hWE);
  346.         if (err <> noErr) then
  347.             goto 1;
  348.  
  349. { lock it down }
  350.         HLock(Handle(hWE));
  351.         pWE := hWE^;
  352.  
  353. { get active port }
  354.         GetPort(pWE^.port);
  355.  
  356. { determine whether temporary memory should be used for data structures }
  357.         if BTST(weFlags, weFUseTempMem) then
  358.             allocFlags := allocFlags + kAllocTemp;
  359.  
  360. { allocate the text handle (initially empty) }
  361.         err := _WEAllocate(0, allocFlags, pWE^.hText);
  362.         if (err <> noErr) then
  363.             goto 1;
  364.  
  365. { allocate the line array }
  366.         err := _WEAllocate(2 * SizeOf(LineRec), allocFlags, pWE^.hLines);
  367.         if (err <> noErr) then
  368.             goto 1;
  369.  
  370. { allocate the style table }
  371.         err := _WEAllocate(SizeOf(StyleTableElement), allocFlags, pWE^.hStyles);
  372.         if (err <> noErr) then
  373.             goto 1;
  374.  
  375. { allocate the run array }
  376.         err := _WEAllocate(2 * SizeOf(RunArrayElement), allocFlags, pWE^.hRuns);
  377.         if (err <> noErr) then
  378.             goto 1;
  379.  
  380. { check for the presence of various system software features }
  381. { determine whether Color QuickDraw is available }
  382.         if (Gestalt(gestaltQuickDrawVersion, response) = noErr) then
  383.             if (response >= gestalt8BitQD) then
  384.                 BSET(weFlags, weFHasColorQD);
  385.  
  386. { determine whether the Text Services manager is available }
  387.         if (Gestalt(gestaltTSMgrVersion, response) = noErr) then
  388.             BSET(weFlags, weFHasTextServices);
  389.  
  390. { determine if there are any non-Roman scripts enabled }
  391.         if (GetScriptManagerVariable(smEnabled) > 1) then
  392.             BSET(weFlags, weFNonRoman);
  393.  
  394. { determine whether a double-byte script is installed }
  395. { the WorldScript Power Enabler breaks the smDoubleByte check (duh!!) }
  396.         if (GetScriptManagerVariable(smDoubleByte) <> 0) then
  397.             BSET(weFlags, weFDoubleByte);
  398.  
  399. { determine whether the Drag Manager is available }
  400.         if (Gestalt(gestaltDragMgrAttr, response) = noErr) then
  401.             if BTST(response, gestaltDragMgrPresent) then
  402.                 BSET(weFlags, weFHasDragManager);
  403.  
  404. { initialize miscellaneous fields of the WE record }
  405.         pWE^.nLines := 1;
  406.         pWE^.nStyles := 1;
  407.         pWE^.nRuns := 1;
  408.         pWE^.viewRect := viewRect;
  409.         pWE^.destRect := destRect;
  410.         pWE^.flags := weFlags;
  411.         pWE^.tsmAreaStart := kInvalidOffset;
  412.         pWE^.tsmAreaEnd := kInvalidOffset;
  413.         pWE^.dragCaretOffset := kInvalidOffset;
  414.  
  415. { initialize hook fields with the addresses of the standard hooks }
  416.         _WESetStandardHooks(hWE);
  417.  
  418. { create a region to hold the view rectangle }
  419.         pWE^.viewRgn := NewRgn;
  420.         WELongRectToRect(viewRect, r);
  421.         RectRgn(pWE^.viewRgn, r);
  422.  
  423. { initialize the style run array }
  424.         with pWE^.hRuns^^[1] do
  425.             begin
  426.                 runStart := 1;
  427.                 styleIndex := -1;
  428.             end;
  429.  
  430. { initialize the style table }
  431.         with pWE^.hStyles^^[0] do
  432.             begin
  433.                 refCount := 1;
  434.  
  435. { copy text attributes from the active graphics port }
  436.                 info.runStyle.tsFont := pWE^.port^.txFont;
  437.                 info.runStyle.tsSize := pWE^.port^.txSize;
  438.                 info.runStyle.tsFace := GrafPtr1(pWE^.port)^.txFace;
  439.                 if BTST(weFlags, weFHasColorQD) then
  440.                     GetForeColor(info.runStyle.tsColor);
  441.                 _WEFillFontInfo(pWE^.port, info);
  442.  
  443.             end;
  444.  
  445. { initialize the line array }
  446.         err := WECalText(hWE);
  447.         if (err <> noErr) then
  448.             goto 1;
  449.  
  450. { register with the Text Services Manager }
  451.         err := _WERegisterWithTSM(hWE);
  452.         if (err <> noErr) then
  453.             goto 1;
  454.  
  455. { unlock the WE record }
  456.         HUnlock(Handle(hWE));
  457.  
  458. { clear result code }
  459.         err := noErr;
  460.  
  461. { skip clean-up section }
  462.         goto 2;
  463.  
  464. 1:
  465. { clean up }
  466.         if (pWE <> nil) then
  467.             begin
  468.                 _WEForgetHandle(pWE^.hText);
  469.                 _WEForgetHandle(pWE^.hLines);
  470.                 _WEForgetHandle(pWE^.hStyles);
  471.                 _WEForgetHandle(pWE^.hRuns);
  472.                 if (pWE^.viewRgn <> nil) then
  473.                     DisposeRgn(pWE^.viewRgn);
  474.             end;
  475.         _WEForgetHandle(hWE);
  476.  
  477. 2:
  478. { return result code }
  479.         WENew := err;
  480.  
  481.     end;  { WENew }
  482.  
  483.     procedure WEDispose (hWE: WEHandle);
  484.         var
  485.             pWE: WEPtr;
  486.             pTable: StyleTablePtr;
  487.             index: LongInt;
  488.     begin
  489.  
  490. { sanity check: make sure WE isn't NIL }
  491.         if (hWE = nil) then
  492.             Exit(WEDispose);
  493.  
  494. { lock the WE record }
  495.         HLock(Handle(hWE));
  496.         pWE := hWE^;
  497.  
  498. { clear the Undo buffer }
  499.         WEClearUndo(hWE);
  500.  
  501. { unregister with the Text Services Manager }
  502.         if (pWE^.tsmReference <> nil) then
  503.             begin
  504.                 if (DeleteTSMDocument(pWE^.tsmReference) <> noErr) then
  505.                     ;
  506.                 pWE^.tsmReference := nil;
  507.             end;
  508.  
  509. { dispose of the offscreen graphics world }
  510.         if (pWE^.offscreenPort <> nil) then
  511.             begin
  512.                 DisposeGWorld(GWorldPtr(pWE^.offscreenPort));
  513.                 pWE^.offscreenPort := nil;
  514.             end;
  515.  
  516.         if (pWE^.hStyles <> nil) then
  517.             begin
  518.  
  519. { lock the style table }
  520.                 HLock(Handle(pWE^.hStyles));
  521.                 pTable := pWE^.hStyles^;
  522.  
  523. { walk the style table, disposing of all embedded objects referenced there }
  524.                 index := 0;
  525.                 while (index < pWE^.nStyles) do
  526.                     with pTable^[index] do
  527.                         begin
  528.                             if (refCount > 0) then
  529.                                 if (_WEFreeObject(WEObjectDescHandle(info.runStyle.tsObject)) <> noErr) then
  530.                                     ;        { don't known what to do with errors }
  531.                             index := index + 1;
  532.                         end;
  533.             end;
  534.  
  535. { dispose of auxiliary data structures }
  536.         _WEForgetHandle(pWE^.hText);
  537.         _WEForgetHandle(pWE^.hLines);
  538.         _WEForgetHandle(pWE^.hStyles);
  539.         _WEForgetHandle(pWE^.hRuns);
  540.         _WEForgetHandle(pWE^.hObjectHandlerTable);
  541.         DisposeRgn(pWE^.viewRgn);
  542.  
  543. { dispose of the WE record }
  544.         DisposeHandle(Handle(hWE));
  545.  
  546.     end;  { WEDispose }
  547.  
  548.     function WEFeatureFlag (feature: Integer;
  549.                                     action: Integer;
  550.                                     hWE: WEHandle): Integer;
  551.         var
  552.             flag: Integer;
  553.             pWE: WEPtr;
  554.     begin
  555.         pWE := hWE^;
  556.  
  557. { get current status of the specified flag }
  558.         flag := Integer(BTST(pWE^.flags, feature));
  559.  
  560. { if action is weBitToggle, invert flag }
  561.         if (action = weBitToggle) then
  562.             action := 1 - flag;
  563.  
  564. { reset flag according to action }
  565.         if (action = weBitClear) then
  566.             BCLR(pWE^.flags, feature)
  567.         else if (action = weBitSet) then
  568.             BSET(pWE^.flags, feature);
  569.  
  570. { return old status }
  571.         WEFeatureFlag := flag;
  572.  
  573.     end;  { WEFeatureFlag }
  574.  
  575.     function WEGetInfo (selector: OSType;
  576.                                     info: Ptr;
  577.                                     hWE: WEHandle): OSErr;
  578.     begin
  579.         WEGetInfo := _WEGetField(_WEMainSelectorTable, selector, info, hWE^);
  580.     end;  { WEGetInfo }
  581.  
  582.     function WESetInfo (selector: OSType;
  583.                                     info: Ptr;
  584.                                     hWE: WEHandle): OSErr;
  585.     begin
  586.         WESetInfo := _WESetField(_WEMainSelectorTable, selector, info, hWE^);
  587.  
  588. { the hook fields can never be NIL, so replace any NIL field with the default address }
  589.         _WESetStandardHooks(hWE);
  590.  
  591.     end;  { WESetInfo }
  592.  
  593. end.